home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / makemic / MAKEMIU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-23  |  8.3 KB  |  322 lines
  1. unit Makemiu;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls,
  8.   DirList;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     GBDirectoryDets: TGroupBox;
  13.     ListBox1: TListBox;
  14.     BaseDirectory: TEdit;
  15.     Label1: TLabel;
  16.     BtnCancel: TButton;
  17.     BtnStart: TButton;
  18.     CBSysFile: TCheckBox;
  19.     CBHidden: TCheckBox;
  20.     CBReadOnly: TCheckBox;
  21.     CBArchive: TCheckBox;
  22.     CBDirectory: TCheckBox;
  23.     BtnStartR1: TButton;
  24.     BtnStartR2: TButton;
  25.     BtnStartR3: TButton;
  26.     procedure BtnStartClick(Sender: TObject);
  27.     procedure BtnCancelClick(Sender: TObject);
  28.     procedure BtnStartR1Click(Sender: TObject);
  29.     procedure BtnStartR2Click(Sender: TObject);
  30.     procedure BtnStartR3Click(Sender: TObject);
  31.     procedure FormCreate(Sender: TObject);
  32.   private
  33.     { Private declarations }
  34.     FAborted: Boolean;
  35.     FCallBack: TScanDirCallBack;
  36. {$IFDEF WIN32}
  37.     FCallBackR1: TScanDirCallBackR1;
  38.     FCallBackR2: TScanDirCallBackR2;
  39.     FCallBackR3: TScanDirCallBackR3;
  40. {$ENDIF}
  41.     procedure DummyDelay(ms: LongInt);
  42. {$IFNDEF WIN32}
  43.     function  ScanDirCallBack(CurrentFile: string; Attr: Byte): Boolean;
  44. {$ELSE}
  45.     function  ScanDirCallBack(CurrentFile: string; Attr: Byte): Boolean; pascal;
  46.     function  ScanDirCallBackR1(CurrentFile: string): Boolean;
  47.     function  ScanDirCallBackR2(CurrentFile: string; Attr: Byte): Boolean;
  48.     function  ScanDirCallBackR3(CurrentFile: string; Attr: Byte; Size: Integer): Boolean;
  49. {$ENDIF}
  50.   public
  51.     { Public declarations }
  52.   end;
  53.  
  54. var
  55.   Form1: TForm1;
  56.  
  57. implementation
  58.  
  59. uses MakeMIC;
  60.  
  61. {$R *.DFM}
  62. procedure TForm1.BtnStartClick(Sender: TObject);
  63. begin
  64.   ListBox1.Items.Clear;
  65.   BtnStart.Enabled := False;
  66. {$IFDEF WIN32}
  67.   BtnStartR1.Enabled := False;
  68.   BtnStartR2.Enabled := False;
  69.   BtnStartR3.Enabled := False;
  70. {$ENDIF}
  71.   FAborted := False;
  72.   @FCallBack := MakeMethodInstance(@TForm1.ScanDirCallBack,Self);
  73.   ScanDir(BaseDirectory.Text,FCallBack);
  74.   FreeMethodInstance(@FCallBack);
  75.   BtnStart.Enabled := True;
  76. {$IFDEF WIN32}
  77.   BtnStartR1.Enabled := True;
  78.   BtnStartR2.Enabled := True;
  79.   BtnStartR3.Enabled := True;
  80. {$ENDIF}
  81. end;
  82.  
  83. { This method is called from all the CallBack routines simply to give you      }
  84. { a chance to cancel the function.                                             }
  85.  
  86. procedure TForm1.DummyDelay(ms: LongInt);
  87. var
  88.   StartTicks: LongInt;
  89.  
  90. begin
  91.   StartTicks := GetTickCount;
  92.   Repeat
  93.     Application.ProcessMessages;
  94.   Until GetTickCount - StartTicks > ms;
  95. end;
  96.  
  97. {$IFNDEF WIN32}
  98. function TForm1.ScanDirCallBack(CurrentFile: string; Attr: Byte): Boolean;
  99. {$ELSE}
  100. function TForm1.ScanDirCallBack(CurrentFile: string; Attr: Byte): Boolean; pascal;
  101. {$ENDIF}
  102. var
  103.   List: Boolean;
  104.   I: longInt;
  105.   AttribStr: string;
  106.  
  107. begin
  108.   Result := FAborted;
  109.   if not FAborted then
  110.     begin
  111.       List := False;
  112.       AttribStr := '';
  113.       if (Attr and faReadOnly) <> 0 then
  114.         begin
  115.           List := CBReadOnly.Checked;
  116.           AttribStr := AttribStr + 'r';
  117.         end;
  118.       if (Attr and faSysFile) <> 0 then
  119.         begin
  120.           List := CBSysFile.Checked or List;
  121.           AttribStr := AttribStr + 's';
  122.         end;
  123.       if (Attr and faHidden) <> 0 then
  124.         begin
  125.           List := CBHidden.Checked or List;
  126.           AttribStr := AttribStr + 'h';
  127.         end;
  128.       if (Attr and faArchive) <> 0 then
  129.         begin
  130.           List := CBArchive.Checked or List;
  131.           AttribStr := AttribStr + 'a';
  132.         end;
  133.       if (Attr and faDirectory) <> 0 then
  134.         begin
  135.           List := CBDirectory.Checked or List;
  136.           AttribStr := AttribStr + 'd';
  137.         end;
  138.       if List then
  139.         ListBox1.Items.Add(CurrentFile + format(' [%s]',[AttribStr]));
  140.     end;
  141.   DummyDelay(25);
  142. end;
  143.  
  144. procedure TForm1.BtnCancelClick(Sender: TObject);
  145. begin
  146.   FAborted := True;
  147. end;
  148.  
  149. procedure TForm1.BtnStartR1Click(Sender: TObject);
  150. begin
  151. {$IFDEF WIN32}
  152.   ListBox1.Items.Clear;
  153.   BtnStart.Enabled := False;
  154.   BtnStartR1.Enabled := False;
  155.   BtnStartR2.Enabled := False;
  156.   BtnStartR3.Enabled := False;
  157.   FAborted := False;
  158.   @FCallBackR1 := MakeMethodInstance32Reg(@TForm1.ScanDirCallBackR1,Self,1);
  159.   ScanDirR1(BaseDirectory.Text,FCallBackR1);
  160.   FreeMethodInstance(@FCallBackR1);
  161.   BtnStart.Enabled := True;
  162.   BtnStartR1.Enabled := True;
  163.   BtnStartR2.Enabled := True;
  164.   BtnStartR3.Enabled := True;
  165. {$ENDIF}
  166. end;
  167.  
  168. procedure TForm1.BtnStartR2Click(Sender: TObject);
  169. begin
  170. {$IFDEF WIN32}
  171.   ListBox1.Items.Clear;
  172.   BtnStart.Enabled := False;
  173.   BtnStartR1.Enabled := False;
  174.   BtnStartR2.Enabled := False;
  175.   BtnStartR3.Enabled := False;
  176.   FAborted := False;
  177.   @FCallBackR2 := MakeMethodInstance32Reg(@TForm1.ScanDirCallBackR2,Self,2);
  178.   ScanDirR2(BaseDirectory.Text,FCallBackR2);
  179.   FreeMethodInstance(@FCallBackR2);
  180.   BtnStart.Enabled := True;
  181.   BtnStartR1.Enabled := True;
  182.   BtnStartR2.Enabled := True;
  183.   BtnStartR3.Enabled := True;
  184. {$ENDIF}
  185. end;
  186.  
  187. procedure TForm1.BtnStartR3Click(Sender: TObject);
  188. begin
  189. {$IFDEF WIN32}
  190.   ListBox1.Items.Clear;
  191.   BtnStart.Enabled := False;
  192.   BtnStartR1.Enabled := False;
  193.   BtnStartR2.Enabled := False;
  194.   BtnStartR3.Enabled := False;
  195.   FAborted := False;
  196.   @FCallBackR3 := MakeMethodInstance32Reg(@TForm1.ScanDirCallBackR3,Self,3);
  197.   ScanDirR3(BaseDirectory.Text,FCallBackR3);
  198.   FreeMethodInstance(@FCallBackR3);
  199.   BtnStart.Enabled := True;
  200.   BtnStartR1.Enabled := True;
  201.   BtnStartR2.Enabled := True;
  202.   BtnStartR3.Enabled := True;
  203. {$ENDIF}
  204. end;
  205.  
  206. {$IFDEF WIN32}
  207. function TForm1.ScanDirCallBackR1(CurrentFile: string): Boolean;
  208. var
  209.   List: Boolean;
  210.   I: longInt;
  211.   AttribStr: string;
  212.  
  213. begin
  214.   Result := FAborted;
  215.   if not FAborted then
  216.     ListBox1.Items.Add(CurrentFile);
  217.   DummyDelay(25);
  218. end;
  219.  
  220. function TForm1.ScanDirCallBackR2(CurrentFile: string; Attr: Byte): Boolean;
  221. var
  222.   List: Boolean;
  223.   I: longInt;
  224.   AttribStr: string;
  225.  
  226. begin
  227.   Result := FAborted;
  228.   if not FAborted then
  229.     begin
  230.       List := False;
  231.       AttribStr := '';
  232.       if (Attr and faReadOnly) <> 0 then
  233.         begin
  234.           List := CBReadOnly.Checked;
  235.           AttribStr := AttribStr + 'r';
  236.         end;
  237.       if (Attr and faSysFile) <> 0 then
  238.         begin
  239.           List := CBSysFile.Checked or List;
  240.           AttribStr := AttribStr + 's';
  241.         end;
  242.       if (Attr and faHidden) <> 0 then
  243.         begin
  244.           List := CBHidden.Checked or List;
  245.           AttribStr := AttribStr + 'h';
  246.         end;
  247.       if (Attr and faArchive) <> 0 then
  248.         begin
  249.           List := CBArchive.Checked or List;
  250.           AttribStr := AttribStr + 'a';
  251.         end;
  252.       if (Attr and faDirectory) <> 0 then
  253.         begin
  254.           List := CBDirectory.Checked or List;
  255.           AttribStr := AttribStr + 'd';
  256.         end;
  257.       if List then
  258.         ListBox1.Items.Add(CurrentFile + format(' [%s]',[AttribStr]));
  259.     end;
  260.   DummyDelay(25);
  261. end;
  262.  
  263. function TForm1.ScanDirCallBackR3(CurrentFile: string; Attr: Byte; Size: Integer): Boolean;
  264. var
  265.   List: Boolean;
  266.   I: longInt;
  267.   AttribStr: string;
  268.  
  269. begin
  270.   Result := FAborted;
  271.   if not FAborted then
  272.     begin
  273.       List := False;
  274.       AttribStr := '';
  275.       if (Attr and faReadOnly) <> 0 then
  276.         begin
  277.           List := CBReadOnly.Checked;
  278.           AttribStr := AttribStr + 'r';
  279.         end;
  280.       if (Attr and faSysFile) <> 0 then
  281.         begin
  282.           List := CBSysFile.Checked or List;
  283.           AttribStr := AttribStr + 's';
  284.         end;
  285.       if (Attr and faHidden) <> 0 then
  286.         begin
  287.           List := CBHidden.Checked or List;
  288.           AttribStr := AttribStr + 'h';
  289.         end;
  290.       if (Attr and faArchive) <> 0 then
  291.         begin
  292.           List := CBArchive.Checked or List;
  293.           AttribStr := AttribStr + 'a';
  294.         end;
  295.       if (Attr and faDirectory) <> 0 then
  296.         begin
  297.           List := CBDirectory.Checked or List;
  298.           AttribStr := AttribStr + 'd';
  299.         end;
  300.       if List then
  301.         ListBox1.Items.Add(CurrentFile + format(' [%s] Size: %d',[AttribStr,Size]));
  302.     end;
  303.   DummyDelay(25);
  304. end;
  305. {$ENDIF}
  306.  
  307. procedure TForm1.FormCreate(Sender: TObject);
  308. begin
  309. {$IFNDEF WIN32}
  310.   BtnStartR1.Visible := False;
  311.   BtnStartR2.Visible := False;
  312.   BtnStartR3.Visible := False;
  313.   BtnStart.Width := 64;
  314.   BtnStart.Left := 50;
  315.   BtnCancel.Left := BtnCancel.Left - 80;
  316.   BtnCancel.Width := 64;
  317. {$ENDIF}
  318. end;
  319.  
  320. end.
  321.  
  322.